home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 19 / CU Amiga Magazine's Super CD-ROM 19 (1998)(EMAP Images)(GB)[!][issue 1998-02].iso / CUCD / Utilities / Scion / ARexx / Links.rexx < prev    next >
OS/2 REXX Batch file  |  1997-11-04  |  12KB  |  446 lines
  1. /****************************************************************************
  2.  *                                                                          *
  3.  * $VER: Links 1.20 (12 Oct 1997)
  4.  *                                                                          *
  5.  *                      Written by Freddy Ariës                             *
  6.  * Address: Lindeboomweg 7, NL-7135 KE Harreveld, The Netherlands.          *
  7.  *                                                                          *
  8.  * ARexx script to find unrelated family trees in the database              *
  9.  * It will detect all family trees within the database that have no links   *
  10.  * (spouse, parent or child links) to other present family trees.           *
  11.  * Eg. useful to find out if you forgot to add a link somewhere...          *
  12.  *                                                                          *
  13.  * This script uses (by default) the rexxreqtools.library (which requires   *
  14.  * a version of reqtools larger than 2.0 and rexxsyslib.library)            *
  15.  * If you do not have these, run SetDefaults.rexx to change the settings.   *
  16.  *                                                                          *
  17.  * DONE:                                                                    *
  18.  * - progress indicator, using rexxarplib.library (requested by R.Akins)    *
  19.  * - now uses preference file for default settings                          *
  20.  * - use of GETFIRSTIRN/GETNEXTIRN/GETLASTIRN commands for v5 and up.       *
  21.  *                                                                          *
  22.  ****************************************************************************/
  23.  
  24. options failat 20; options results
  25. arg outname outval
  26.  
  27. versionstr = "1.20"
  28.  
  29. /* Don't change the settings here! Run SetDefaults.rexx instead! */
  30. usereq = 1; prgrs = 1; pgopen = 0
  31. outp = 1; output = stdout; scrdev = stdout
  32. PSCR = 'SCIONGEN'
  33. plwidth = 78; pgsize = 0
  34.  
  35. fill = 4;      /* number of spaces at the beginning of lines */
  36. useirn = 1; pgline = 1
  37. scrname = "CON:0//639//Scion_Output/AUTO/WAIT/CLOSE/SCREEN"
  38. NL = '0A'x
  39.  
  40. signal on IOERR
  41.  
  42. do while outname = '?'
  43.   writeln(stdout, "OUTFILE/A,QUIET/S,NOREQ/S ")
  44.   pull outname outval
  45. end
  46.  
  47. /* read preferences file */
  48.  
  49. if open(pfile, 'ENV:Scion/ScionRexx.prefs', 'r') then do
  50.   do while ~eof(pfile)
  51.     inln = readln(pfile)
  52.     if inln ~= "" then do
  53.       wstr = upper(word(inln, 1))
  54.       if wstr = "USEREQ" then
  55.         usereq = 1
  56.       else if wstr = "NOUSEREQ" then
  57.         usereq = 0
  58.       else if wstr = "PROGRESS" then
  59.         prgrs = 1
  60.       else if wstr = "NOPROGRESS" then
  61.         prgrs = 0
  62.       else if wstr = "PUBSCREEN" then
  63.         pscr = strip(delstr(inln, 1, length(wstr)), 'b', ' "')
  64.       else if wstr = "LINEWIDTH" then do
  65.         wstr = word(inln, 2)
  66.         if datatype(wstr, 'w') then plwidth = wstr
  67.       end
  68.       else if wstr = "PAGESIZE" then do
  69.         wstr = word(inln, 2)
  70.         if datatype(wstr, 'w') then pgsize = wstr
  71.       end
  72.     end
  73.   end
  74.   close(pfile)
  75. end
  76.  
  77. if pscr = "" | (pscr ~= "WORKBENCH" & ~show('p', pscr)) then
  78.   pscr = "SCIONGEN"
  79. scrname = scrname||pscr
  80.  
  81. /* command line options get priority over global settings */
  82.  
  83. if outname ~= "" then do
  84.   if outname = "QUIET" | outname = "NOREQ" then do
  85.     outval = outname; outname = ""
  86.   end
  87. end
  88.  
  89. if outval = "QUIET" then do
  90.   outp = 0; usereq = 0; prgrs = 0
  91. end
  92. else if outval = "NOREQ" then do
  93.   usereq = 0; prgrs = 0
  94. end
  95.  
  96. if usereq & ~show('l','rexxreqtools.library') then do
  97.   if exists('libs:rexxreqtools.library') then
  98.     call addlib('rexxreqtools.library',0,-30,0)
  99.   else do
  100.     usereq = 0; outp = 1
  101.     Tell("Unable to open rexxreqtools.library - using text output")
  102.   end
  103. end
  104.  
  105. if ~usereq then prgrs = 0
  106.  
  107. /* Originally stolen from Peter Billing - thanks Peter ;-) */
  108. if ~show('P','SCIONGEN') then do
  109.   EndString('I am sorry to say that the SCION Genealogist' || NL ||,
  110.     'database is not available. Please start the' || NL ||,
  111.     'SCION program BEFORE using this script!')
  112. end
  113.  
  114. if prgrs & ~show('l','rexxarplib.library') then do
  115.   if exists('libs:rexxarplib.library') then
  116.     call addlib('rexxarplib.library',0,-30,0)
  117.   else
  118.     prgrs = 0
  119. end
  120.  
  121. screentofront(pscr)
  122.  
  123. myport = "SCIONGEN"
  124. address value myport
  125. GETDBNAME
  126. dbname = upper(RESULT)
  127.  
  128. Arrays. = ""
  129. arr = 1; Arrays.1 = "1 "
  130. NumArrs = 1; Found = 1
  131.  
  132. if outp & ~usereq then do
  133.   if pscr ~= "WORKBENCH" then do
  134.     scrdev = 'SCNLNKSCR'
  135.     if ~open(scrdev, scrname, 'w') then scrdev = stdout
  136.   end
  137.   Tell("Scion Links Finder v"||versionstr||" by Freddy Ariës")
  138.   Tell("Current Scion database: "||dbname)
  139.   Tell("Be patient - this may take a while...")
  140. end
  141.  
  142. /* It's a good habit to add the ".scion" extension to Scion database files */
  143. dblen = length(dbname)
  144. if dblen>6 & right(dbname, 6)=".SCION" then dbname=left(dbname, dblen - 6)
  145.  
  146. if outname = "" then do
  147.   if outp then do
  148.     if usereq then do
  149.       odev = rtezrequest('Current Scion database: '||dbname||,
  150.        NL||'Where should the Links output be sent to?'||,
  151.        NL,' _File |_Printer|_Screen|_Nowhere','Scion Links Finder v'||versionstr||' by Freddy Ariës','rt_pubscrname = '||PSCR)
  152.       select
  153.         when odev = 1 then do
  154.           /* We need a file requester for further data */
  155.           outname = rtfilerequest(,dbname||'.LNK','Output filename',,'rtfi_buffer = true   rt_pubscrname = '||PSCR||'   rtfi_initialpath = RAM:',)
  156.           if outname = '' then
  157.             outname = dbname||'.LNK'
  158.         end
  159.         when odev = 2 then
  160.           outname = 'PRT:'
  161.         when odev = 3 then
  162.           outname = 'STDOUT'
  163.         otherwise
  164.           EXIT
  165.           /* You selected 'Nowhere' */
  166.       end
  167.     end
  168.     else do
  169.       Tell("Enter output file (filename with complete path, or PRT: for printer,")
  170.       TellNN("or STDOUT for screen): ")
  171.       outname = readln(scrdev)
  172.       outname = strip(outname, 'b', ' "')
  173.       Tell("Destination: "||outname)
  174.       TellNN("Continue (y/n)? ")
  175.       conf = readln(scrdev)
  176.       conf = upper(left(conf, 1))
  177.       /* Note that left works on empty strings ("") too! */
  178.       if conf ~= "Y" then
  179.         EndString("Goodbye...")
  180.       Tell("")
  181.     end
  182.   end
  183.   else
  184.     outname = "RAM:"dbname".LNK"
  185.     /* If we're not allowed to use stdout, default to this filename */
  186. end
  187.  
  188. if prgrs then do
  189.   Postmsg(10, 10, "Scion Links Finder (by Freddy Ariës)\Database: "||dbname||"\ \ ", PSCR)
  190.   pgopen = 1
  191. end
  192.  
  193. if (prgvers >= 5) then
  194. do
  195.   GETFIRSTIRN
  196.   CurrIRN = RESULT
  197.   GETLASTIRN
  198.   TotalIRN = RESULT
  199. end
  200. else do
  201.   GETTOTALIRN
  202.   TotalIRN = RESULT
  203.   CurrIRN = 1
  204. end
  205.  
  206. if pgopen then Postmsg(,, "\\Processing person:\", PSCR)
  207.  
  208. do while (CurrIRN > 0) & (CurrIRN <= TotalIRN)
  209.   if pgopen then Postmsg(,,"\\\"||CurrIRN||" (of "||TotalIRN||")", PSCR)
  210.   if Found then do
  211.     MarrNum = 0; marrexist = 1
  212.  
  213.     do while marrexist
  214.       GETMARRIAGE CurrIRN MarrNum
  215.       marriage = RESULT
  216.       EXISTFAMILY marriage
  217.       if RESULT = 'YES' then do
  218.         marrexist = 1
  219.  
  220.     PrsnIRN = 0
  221.     GETPRINCIPAL marriage
  222.     ptnr = RESULT
  223.     EXISTPERSON ptnr
  224.     if RESULT = 'YES' then do
  225.       if ptnr ~= CurrIRN then PrsnIRN = ptnr
  226.     end
  227.     if PrsnIRN = 0 then do
  228.       GETSPOUSE marriage
  229.       ptnr = RESULT
  230.       EXISTPERSON ptnr
  231.       if RESULT = 'YES' then do
  232.         if ptnr ~= CurrIRN then PrsnIRN = ptnr
  233.       end
  234.     end
  235.  
  236.     EXISTPERSON PrsnIRN
  237.         if RESULT = 'YES' then
  238.           arr = HandlePerson(PrsnIRN)
  239.  
  240.     ChildNum = 0; childexist = 1
  241.     do while childexist
  242.       GETCHILD marriage ChildNum
  243.       child = RESULT
  244.       EXISTPERSON child
  245.       if RESULT = 'YES' then do
  246.             childexist = 1
  247.         arr = HandlePerson(child)
  248.         ChildNum = ChildNum + 1
  249.       end
  250.       else childexist = 0
  251.     end
  252.  
  253.         MarrNum = MarrNum + 1
  254.       end
  255.       else marrexist = 0
  256.     end
  257.  
  258.     GETPARENTS CurrIRN
  259.     ParFGRN = RESULT
  260.     EXISTFAMILY ParFGRN
  261.     if RESULT = 'YES' then do
  262.       GETPRINCIPAL ParFGRN
  263.       PrsnIRN = RESULT
  264.       EXISTPERSON PrsnIRN
  265.       if RESULT = 'YES' then do
  266.         arr = HandlePerson(PrsnIRN)
  267.       end
  268.  
  269.       GETSPOUSE ParFGRN
  270.       PrsnIRN = RESULT
  271.       EXISTPERSON PrsnIRN
  272.       if RESULT = 'YES' then
  273.         arr = HandlePerson(PrsnIRN)
  274.  
  275.       /* Note that we don't have to process siblings, because they will
  276.        * be processed with their parents, and because you cannot create
  277.        * a family group without at least one parent
  278.        */
  279.     end
  280.   end
  281.  
  282.   if (prgvers >= 5) then
  283.   do
  284.      GETNEXTIRN CurrIRN
  285.      CurrIRN = RESULT
  286.   end
  287.   else do
  288.      CurrIRN = CurrIRN + 1
  289.   end
  290.   EXISTPERSON CurrIRN
  291.  
  292.   if RESULT = 'YES' then do
  293.    arr = GetArray(CurrIRN)
  294.    Found = 1
  295.   end
  296.   else Found = 0
  297. end
  298.  
  299. if pgopen then Postmsg(,, "\\Writing output...\ ", PSCR)
  300.  
  301. if outname ~= "STDOUT" then do
  302.   output = 'OUTPUT'
  303.   if ~open(output, outname, "w") then
  304.     EndString("ERROR: Unable to open output file.")
  305. end
  306. else do
  307.   if ~outp | usereq then do /* output screen wasn't opened yet! */
  308.     scrdev = 'SCNLNKSCR'
  309.     if ~open(scrdev, scrname, 'w') then scrdev = stdout
  310.   end
  311.   output = scrdev
  312. end
  313.  
  314. /* Now output the resulting arrays of IRNs! */
  315. do out = 1 for NumArrs
  316.   PrintLines("Group "||out||": "||Arrays.out, fill)
  317. end
  318.  
  319. if usereq then do
  320.   rtezrequest('Scion Links Finder is ready.' || NL ||'Persons parsed: '||,
  321.     TotalIRN,'_Ok','Links Message:','rt_pubscrname = '||PSCR)
  322.   if pgopen then Postmsg()
  323. end
  324. else
  325.   EndString("Done ("||TotalIRN||" persons parsed)."||NL)
  326.  
  327. EXIT
  328.  
  329. GetArray: PROCEDURE EXPOSE Arrays. NumArrs
  330. parse arg prsn
  331. do CurrArr = 1 for NumArrs
  332.   col = find(Arrays.CurrArr, prsn)
  333.   if col > 0 then return CurrArr
  334. end
  335. /* Not already present, then give person a new array */
  336. NumArrs = NumArrs + 1
  337. Arrays.NumArrs = prsn||' '
  338. return NumArrs
  339.  
  340. MergeArrs: PROCEDURE EXPOSE Arrays. NumArrs
  341. parse arg arr1, arr2
  342. if arr1 <= arr2 then do
  343.   minarr = arr1; maxarr = arr2
  344. end
  345. else do
  346.   minarr = arr2; maxarr = arr1
  347. end
  348. Arrays.minarr = Arrays.minarr||Arrays.maxarr
  349. if maxarr ~= NumArrs then
  350.   Arrays.maxarr = Arrays.NumArrs
  351. Arrays.NumArrs = ""
  352. NumArrs = NumArrs - 1
  353. return minarr
  354.  
  355. HandlePerson: PROCEDURE EXPOSE Arrays. NumArrs arr
  356. parse arg prsn
  357. CurrArr = 1; pers = 0
  358. do until pers ~=  0 | CurrArr > NumArrs
  359.   if find(Arrays.CurrArr, prsn) > 0 then pers = CurrArr
  360.   CurrArr = CurrArr + 1
  361. end
  362. if pers = 0 then do
  363.   /* Person isn't already present; give him same array as CurrIRN person */
  364.   pers = arr
  365.   Arrays.arr = Arrays.arr||prsn||' '
  366. end
  367. if pers ~= arr then
  368.   arr = MergeArrs(pers, arr)
  369. return arr
  370.  
  371. PrintLines: PROCEDURE EXPOSE output plwidth pgline pgsize
  372. parse arg ostr, fill
  373. do while ostr ~= ""
  374.   nnl = plwidth
  375.   if length(ostr) >= plwidth then do
  376.     do until pc = ' ' | nnl = 1
  377.       pc = substr(ostr, nnl, 1)
  378.       nnl = nnl - 1
  379.     end
  380.     if nnl = 1 then do
  381.       prtstr = left(ostr, plwidth-1)
  382.       ostr = delstr(ostr, 1, nnl)
  383.     end
  384.     else do
  385.       prtstr = left(ostr, nnl)
  386.       ostr = delstr(ostr, 1, nnl+1)
  387.     end
  388.   end
  389.   else do
  390.     prtstr = ostr
  391.     ostr = ""
  392.   end
  393.   DoWrite(output, prtstr)
  394.   if ostr ~= "" then
  395.     ostr = copies(' ',fill)||ostr
  396. end
  397. return 0
  398.  
  399. /*
  400.  * output at most #pgsize lines per page to the print device
  401.  * if pgsize = 0, this feature is turned off (unlimited #lines per page)
  402.  */
  403. DoWrite: PROCEDURE EXPOSE pgline pgsize
  404. parse arg prtdev, ostr
  405. if pgsize ~= 0 & pgline > pgsize then do
  406.   writech(prtdev, '0C'x); /* CTRL-L; next page */
  407.   pgline = 0
  408. end
  409. writeln(prtdev, ostr)
  410. pgline = pgline + 1
  411. return 0
  412.  
  413. Tell: PROCEDURE EXPOSE outp scrdev
  414. parse arg str
  415. if outp then writeln(scrdev, str)
  416. return 0
  417.  
  418. TellNN: PROCEDURE EXPOSE outp scrdev
  419. parse arg str
  420. if outp then writech(scrdev, str)
  421. return 0
  422.  
  423. EndString: PROCEDURE EXPOSE outp output usereq pgopen scrdev pscr
  424. parse arg str
  425. if pgopen then Postmsg()
  426. /* If you turned off stdout, no error messages will be shown! */
  427. if usereq then
  428.   rtezrequest(str,'E_xit','Links Message:','rt_pubscrname = '||PSCR)
  429. else do
  430.   Tell(str || '0A'x)
  431. end
  432. if outp & ~usereq & (scrdev ~= stdout) then do
  433.   Tell("Press <return> to exit.")
  434.   readln(scrdev)
  435.   close(scrdev)
  436. end
  437. close(output)
  438. EXIT
  439.  
  440. IOERR:
  441.   bline = SIGL
  442.   say "I/O error #"||RC||" detected in line "||bline||":"
  443.   say sourceline(bline)
  444.   if pgopen then Postmsg()
  445.   EXIT
  446.